|| introduce b as {0,1}
b == num

|| introduce the simplex atoms
s_not :: b -> b
s_not 0 = 1
s_not 1 = 0

s_and :: (b,b) -> b
s_and (0,x) = 0
s_and (x,0) = 0
s_and (1,1) = 1

s_nand :: (b,b) -> b
s_nand (0,x) = 1
s_nand (x,0) = 1
s_nand (1,1) = 0

s_nand3 :: (b,b,b) -> b
s_nand3 (0,x,y) = 1
s_nand3 (x,0,y) = 1
s_nand3 (x,y,0) = 1
s_nand3 (1,1,1) = 0

s_nand4 :: (b,b,b,b) -> b
s_nand4 (0,x,y,z) = 1
s_nand4 (x,0,y,z) = 1
s_nand4 (x,y,0,z) = 1
s_nand4 (x,y,z,0) = 1
s_nand4 (1,1,1,1) = 0

s_or :: (b,b) -> b
s_or (1,x) = 1
s_or (x,1) = 1
s_or (0,0) = 0

s_xor :: (b,b) -> b
s_xor (x,x) = 0
s_xor (x,y) = 1

|| introduce the multiplex ones
m_not :: [b] -> [b]
m_not [] = []
m_not (a:r) = s_not a:m_not r

m_and :: ([b],[b]) -> [b]
m_and ([], x) = []
m_and (x, []) = []
m_and (a:r, b:s) = s_and (a,b):m_and (r,s)

m_or :: ([b],[b]) -> [b]
m_or ([], x) = []
m_or (x, []) = []
m_or (a:r, b:s) = s_or (a,b):m_or (r,s)

m_xor :: ([b],[b]) -> [b]
m_xor ([],x) = []
m_xor (x,[]) = []
m_xor (a:r, b:s) = s_xor (a,b):m_xor (r,s)

|| introduce some flipflops
|| the initial state is given as first arg
m_dff :: b -> [b] -> [b]
m_dff q [] = [q]
m_dff q (d:r) = q:m_dff d r

|| de jkff heeft een hulp functie nodig voor de toestandsovergang
m_jkff :: b -> ([b],[b]) -> [b]
m_jkff q ([], k) = [q]
m_jkff q (j, []) = [q]
m_jkff q (j:d, k:d') = q:m_jkff (m_jknew q (j,k)) (d, d')
		       where
                          m_jknew 0 (j, k) = j
                          m_jknew 1 (j, k) = s_not k

|| Def
||    parity :- B => B;
||    parity i = q where q = dff 0 (xor (q,i)) endwhere
m_parity :: [b] -> [b]
m_parity d = q
             where q = 0:(m_xor (q,d))
|| Zet je in het rechter lid where q = m_dff 0 (m_xor (q,d))
|| krijg je een BLACK HOLE omdat het tweede argument van m_dff
|| nodig is om op te pattern matchen

|| Op naar DTM
dom == num -> b

|| Voor het experiment willen we lijsten naar doms
|| kunnen converteren en vice versa
todom :: [b] -> dom
todom [] n = 0
todom (a:r) 0 = a
todom (a:r) n = todom r (n-1)

fromdom :: num -> dom -> [b]
fromdom n f = fdom n f 0
              where
                 fdom n f k = [],n <= k;
		 fdom n f k = f k:fdom n f (k+1), n > k

fromdom2 :: num -> (dom,dom) -> [(b,b)]
fromdom2 n (f,g) = fdom2 n (f,g) 0
		   where
			fdom2 n (f,g) k = [],n <= k;
			fdom2 n (f,g) k = (f k,g k):fdom2 n (f,g) (k+1), n > k

|| We hebben ook zoiets als een tail operatie op doms nodig
taild :: dom -> dom
taild d n = d (n+1)

|| nu de atoms
dtm_not :: dom -> dom
dtm_not d n = s_not (d n)

dtm_and :: (dom, dom) -> dom
dtm_and (a,b) n = s_and (a n,b n)

dtm_or :: (dom, dom) -> dom
dtm_or (a,b) n = s_or (a n, b n)

dtm_xor :: (dom, dom) -> dom
dtm_xor (a,b) n = s_xor (a n,b n)

dtm_dff :: b -> dom -> dom
dtm_dff q d 0 = q
dtm_dff q d n = d (n-1)

|| of als
dtm_mdff :: b -> dom -> dom
dtm_mdff q d 0 = q
dtm_mdff q d n = dtm_mdff (d 0) (taild d) (n-1)

|| Ook de jkff gaat op die manier
dtm_jkff :: b -> (dom,dom) -> dom
dtm_jkff q (j,k) 0 = q
dtm_jkff q (j,k) n = dtm_jkff (dtm_jknew q (j 0,k 0)) (taild j,taild k) (n-1)
		     where
			dtm_jknew 0 (j,k) = j
			dtm_jknew 1 (j,k) = s_not k

|| Nu de grote test
dtm_parity :: dom -> dom
dtm_parity d = q
	       where
		  q = dtm_mdff 0 (dtm_xor (q,d))

|| Kunnen we het misschien wel nog iets preciezer
|| in TTL is de standaard poortvertraging ongeveer 10 ns
|| we laten nu een stap in de tijd hiermee corresponderen

|| eerst de poorten:
ttl_not :: dom -> dom
ttl_not d 0 = 0			|| Initieel is alles in rust
ttl_not d n = s_not (d (n-1))

ttl_and :: (dom,dom) -> dom
ttl_and (a,b) 0 = 0
ttl_and (a,b) n = s_and (a (n-1),b (n-1))

ttl_nand :: (dom,dom) -> dom
ttl_nand (a,b) 0 = 0
ttl_nand (a,b) n = s_nand (a (n-1),b (n-1))

ttl_nand3 :: (dom,dom,dom) -> dom
ttl_nand3 (a,b,c) 0 = 0
ttl_nand3 (a,b,c) n = s_nand3 (a (n-1), b (n-1),c (n-1))

ttl_nand4 :: (dom,dom,dom,dom) -> dom
ttl_nand4 (a,b,c,d) 0 = 0
ttl_nand4 (a,b,c,d) n = s_nand4 (a (n-1), b (n-1),c (n-1),d (n-1))

ttl_or :: (dom,dom) -> dom
ttl_or (a,b) 0 = 0
ttl_or (a,b) n = s_or (a (n-1),b (n-1))

ttl_xor :: (dom,dom) -> dom
ttl_xor (a,b) 0 = 0
ttl_xor (a,b) 1 = 0
ttl_xor (a,b) n = s_xor (a (n-2), b (n-2))

|| Een schakeling met een hazard op de s ingang
ttl_hazard :: (dom,dom,dom) -> dom
ttl_hazard (s, a, b) = ttl_and (ttl_and (s,b), ttl_and (ttl_not s, a))

||
|| Def
||    RSFF :- B & B => B & B;
||    RSFF (r,s) = (q,q')
||	where
||	   q = nand (q',s)
||	   q' = nand (q,s)
||	endwhere

ttl_rsff :: (dom,dom) -> (dom,dom)
ttl_rsff (r,s) = (q,q')
		 where
		    q = ttl_nand (q',s)
		    q'= ttl_nand (q,r)

||
|| Def
||    DFF :- B & B => B & B;
||    DFF (ck, d) = (q, q')
||	where
||	   q = nand (q', q1);
||	   q' = nand (q, q2);
||	   q1 = nand (u1, ck);
||	   u1 = nand (u4,q1);
||	   q2 = nand3 (q1,ck,u4);
||	   u4 = nand (q2, d)
||	endwhere

dff :: (dom,dom) -> (dom,dom)
dff (ck, d) = (q,q')
	      where
	         q = ttl_nand (q', q1)
	         q' = ttl_nand (q, q2)
	         q1 = ttl_nand (u1, ck)
	         u1 = ttl_nand (u4,q1)
	         q2 = ttl_nand3 (q1,ck,u4)
	         u4 = ttl_nand (q2, d)

ttl_dff :: (dom,dom,dom,dom) -> (dom,dom)
ttl_dff (ck,d,clr,pr) = (q,q')
			where
			   q = ttl_nand3 (q',q1,pr)
			   q' = ttl_nand3 (q,q2,clr)
			   q1 = ttl_nand3 (u1, ck, clr)
			   u1 = ttl_nand3 (u4, q1, pr)
			   q2 = ttl_nand3 (q1, ck, u4)
			   u4 = ttl_nand3 (q2, d, clr)

int0 :: dom
int0 0 = 0
int0 1 = 0
int0 n = 1

ones :: dom
ones n = 1

div2 :: dom -> dom
div2 ck = q
	  where
	     (q,q') = dff (ck,q')

ttl_div2 :: dom -> dom
ttl_div2 ck = q
	      where
		(q,q') = ttl_dff (ck,q',int0,ones)

ttl_jkff :: (dom,dom,dom,dom) -> (dom,dom)
ttl_jkff (ck,j,k,clr) = (q,q')
		        where
		          q = ttl_nand (q',a)
		          q' = ttl_nand3 (q,clr,b)
		          a = ttl_nand (ck', q1)
		          b = ttl_nand (ck', q1')
		          q1 = ttl_nand (q1', c)
		          q1' = ttl_nand3 (q1,clr,d)	
		          c = ttl_nand4 (ck, q', j,clr)
		          d = ttl_nand3 (ck, q, k)
		          ck' = ttl_not ck

ttl_mjkff :: (dom,dom,dom,dom) -> (dom,dom)
ttl_mjkff (ck,j,k,clr) = (q,q')
			 where
			    q = ttl_nand (q',a)
			    q' = ttl_nand3 (q, clr, b)
			    a = ttl_nand (q1, c)
			    b = ttl_nand (q1', d)
			    q1 = ttl_nand (c, q1')
			    q1' = ttl_nand3 (d, clr, q1)
			    c = ttl_nand4 (ck, q', j,clr)
			    d = ttl_nand3 (ck, q, k)

delay :: num -> dom -> dom
delay k d n = 0, n < k
delay k d n = s_not (d (n - k))

oscil :: num -> dom
oscil k = q where q = delay k q
